home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / lib / w3m / cgi-bin / w3mmail.cgi < prev    next >
Text File  |  2009-06-30  |  10KB  |  405 lines
  1. #!/usr/bin/perl
  2.  
  3. $rcsid = q$Id: w3mmail.cgi.in,v 1.14 2004/08/30 16:32:24 ukai Exp $;
  4. ($id = $rcsid) =~ s/^.*,v ([\d\.]*).*/$1/;
  5. ($prog=$0) =~ s/.*\///;
  6.  
  7. $query = $ENV{'QUERY_STRING'};
  8. $cookie_file = $ENV{'LOCAL_COOKIE_FILE'};
  9. $local_cookie = '';
  10. $SENDMAIL = '/usr/lib/sendmail';
  11. $SENDMAIL = '/usr/sbin/sendmail' if -x '/usr/sbin/sendmail';
  12. $SENDMAIL_OPT = '-oi -t';
  13.  
  14. if (-f $cookie_file) {
  15.     open(F, "< $cookie_file");
  16.     $local_cookie = <F>;
  17.     close(F);
  18. }
  19. if ($query =~ s/^\w+://) {
  20.     $url = $query;
  21.     $qurl = &html_quote($url);
  22.     $to = $query;
  23.     $opt = '';
  24.     if ($to =~ /^([^?]*)\?(.*)$/) {
  25.     $to = $1;
  26.     $opt = $2;
  27.     }
  28.     $to = &url_unquote($to);
  29.     %opt = &parse_opt($opt);
  30.  
  31.     @to = ($to);
  32.     push(@to, $opt{'to'}) if ($opt{'to'});
  33.     $opt{'to'} = join(',', @to);
  34.     if ($ENV{'REQUEST_METHOD'} eq 'POST') {
  35.     sysread(STDIN, $body, $ENV{'CONTENT_LENGTH'});
  36.     $content_type = $ENV{'CONTENT_TYPE'};
  37.     if ($content_type =~ /^multipart\/form-data;\s+boundary=(.*)$/) {
  38.         $boundary = $1;
  39.     }
  40.     } else {
  41.     $body = $opt{'body'};
  42.     delete $opt{'body'};
  43.     }
  44.     &lang_setup;
  45.  
  46.     print "Content-Type: text/html; charset=$charset\r\n";
  47.     print "w3m-control: END\r\n";
  48.     print "w3m-control: PREV_LINK\r\n";
  49.     print "\r\n";
  50.     print "<html><head><title>W3M Mailer: $qurl</title></head>\n";
  51.     print "<body><h1>W3M Mailer: $qurl</h1>\n";
  52.     print "<form action=\"file://$0\" method='POST'>\n";
  53.     $local_cookie = &html_quote($local_cookie);
  54.     print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n";
  55.     print "<table>\n";
  56.     foreach $h ('from', 'to', 'cc', 'bcc', 'subject') {
  57.     $v = &lang_html_quote($opt{$h});
  58.     print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v\">\n";
  59.     delete $opt{$h};
  60.     }
  61.     if ($boundary) {
  62.     $boundary = &html_quote($boundary);
  63.     print "<tr><td>Content-Type:<td>multipart/form-data; boundary=\"$boundary\"\n";
  64.     print "<input type='hidden' name='boundary' value=\"$boundary\">\n";
  65.     }
  66.     foreach $h (keys %opt) {
  67.     $qh = &html_quote($h);
  68.     $v = &lang_html_quote($opt{$h});
  69.     print "<tr><td>\u$h:<td>$v\n";
  70.     print "<input type='hidden' name=\"$qh\" value=\"$v\">\n";
  71.     }
  72.     print "<tr><td colspan=2>\n";
  73.     print "<textarea cols=40 rows=10 name='body'>\n";
  74.     if ($body) {
  75.     print &lang_html_quote($body);
  76.     }
  77.     print "</textarea>\n";
  78.     print "</table>\n";
  79.     print "<input type='submit' name='action' value='Preview'>\n";
  80.     print "</form>\n";
  81.     print "</body></html>\n";
  82.     exit(0);
  83. } else {
  84.     sysread(STDIN, $req, $ENV{'CONTENT_LENGTH'});
  85.     %opt = &parse_opt($req);
  86.     if ($local_cookie ne $opt{'cookie'}) {
  87.     print "Content-Type: text/plain\r\n";
  88.     print "\r\n";
  89.     print "Local cookie doesn't match: It may be an illegal execution\n";
  90.     exit 1;
  91.     }
  92.     delete $opt{'cookie'};
  93.     $body = $opt{'body'};
  94.     delete $opt{'body'};
  95.     $act = $opt{'action'};
  96.     delete $opt{'action'};
  97.     $boundary = $opt{'boundary'};
  98.     delete $opt{'boundary'};
  99.     &lang_setup;
  100.  
  101.     if ($act eq "Preview") {
  102.     print "Content-Type: text/html; charset=$charset\r\n";
  103.     print "w3m-control: DELETE_PREVBUF\r\n";
  104.     print "w3m-control: NEXT_LINK\r\n";
  105.     print "\r\n";
  106.     print "<html><head><title>W3M Mailer</title></head>\n";
  107.     print "<body>\n";
  108.     print "<h1>W3M Mailer: preview</h1>\n";
  109.     print "<form action=\"file://$0\" method='POST'>\n";
  110.     $local_cookie = &html_quote($local_cookie);
  111.     print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n";
  112.     print "<hr>\n";
  113.     print "<pre>\n";
  114.     foreach $h (keys %opt) {
  115.         $qh = &html_quote($h);
  116.         $v{$h} = &lang_html_quote($opt{$h});
  117.         if ($v{$h}) {
  118.         print "\u$qh: $v{$h}\n";
  119.         }
  120.     }
  121.     ($cs,$cte,$body) = &lang_body(&lang_html_quote($body), 0);
  122.     print "Mime-Version: 1.0\n";
  123.     if ($boundary) {
  124.         $boundary = &html_quote($boundary);
  125.         print "Content-Type: multipart/form-data;\n";
  126.         print "    boundary=\"$boundary\"\n";
  127.     } else {
  128.         print "Content-Type: text/plain; charset=$cs\n";
  129.     }
  130. #    print "Content-Transfer-Encoding: $cte\n";
  131.     print "User-Agent: ", &html_quote("$ENV{'SERVER_SOFTWARE'} $prog/$id"),
  132.         "\n";
  133.     print "\n";
  134.     print $body;
  135.     print "\n" if ($body !~ /\n$/);
  136.     print "</pre>\n";
  137.     print "<input type='submit' name='action' value='Send'>\n";
  138.     print "<hr>\n";
  139.     print "<table>\n";
  140.     foreach $h ('from', 'to', 'cc', 'bcc', 'subject') {
  141.         print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v{$h}\">\n";
  142.         delete $opt{$h};
  143.     }
  144.     if ($boundary) {
  145.         print "<tr><td>Content-Type:<td>Content-Type: multipart/form-data; boundary=\"$boundary\"\n";
  146.         print "<input type='hidden' name=\"boundary\" value=\"$boundary\">\n";
  147.     }
  148.     foreach $h (keys %opt) {
  149.         $qh = &html_quote($h);
  150.         print "<tr><td>\u$qh:<td>$v{$h}\n";
  151.         print "<input type='hidden' name=\"$qh\" value=\"$v{$h}\">\n";
  152.     }
  153.     print "<tr><td colspan=2>\n";
  154.     print "<textarea cols=40 rows=10 name=body>\n";
  155.     if ($body) {
  156.         print $body;
  157.     }
  158.     print "</textarea>\n";
  159.     print "</table>\n";
  160.     print "<input type='submit' name='action' value='Preview'><br>\n";
  161.     print "</body></html>\n";
  162.     } else {
  163. # XXX: quote?
  164. #    if ($opt{'from'}) {
  165. #        $sendmail_fromopt = '-f' . $opt{'from'};
  166. #    }
  167.     unless (open(MAIL, "|$SENDMAIL $SENDMAIL_OPT")) {
  168.         print "Content-Type: text/html\r\n";
  169.         print "\r\n";
  170.         print "<html><head><title>W3M Mailer</title></head>\n";
  171.         print "<body><h1>W3M Mailer: open sendmail failed</h1>\n";
  172.         print "<p>", &html_quote($@), "</p>\n";
  173.         print "</body></html>\n";
  174.         exit(0);
  175.     }
  176.     foreach $h (keys %opt) {
  177.         $v = &lang_header($opt{$h});
  178.         if ($v) {
  179.         print MAIL "\u$h: $v\n";
  180.         }
  181.     }
  182.     ($cs,$cte,$body) = &lang_body($body, 1);
  183.     $body =~ s/\r//g;
  184.     print MAIL "Mime-Version: 1.0\n";
  185.     if ($boundary) {
  186.         print MAIL "Content-Type: multipart/form-data;\n";
  187.         print MAIL "    boundary=\"$boundary\"\n";
  188.     } else {
  189.         print MAIL "Content-Type: text/plain; charset=$cs\n";
  190.     }
  191.     print MAIL "Content-Transfer-Encoding: $cte\n";
  192.     print MAIL "User-Agent: $ENV{'SERVER_SOFTWARE'} $prog/$id\n";
  193.     print MAIL "\n";
  194.     print MAIL $body;
  195.     if (close(MAIL)) {
  196.         print "w3m-control: DELETE_PREVBUF\r\n";
  197.         print "w3m-control: BACK\r\n";
  198.         print "\r\n";
  199.     } else {
  200.         print "Content-Type: text/html\r\n";
  201.         print "\r\n";
  202.         print "<html><head><title>W3M Mailer</title></head>\n";
  203.         print "<body><h1>W3M Mailer: close sendmail failed</h1>\n";
  204.         print "<p>", &html_quote($@), "</p>\n";
  205.         print "</body></html>\n";
  206.     }
  207.     }
  208. }
  209.  
  210. sub lang_setup {
  211.     $lang = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'};
  212.     if ($lang =~ /^ja/i) {
  213.     eval "use NKF;";
  214.     if (! $@) {
  215.         $use_NKF = 1;
  216.     } else {
  217.         $use_NKF = 0;
  218.     }
  219.     $charset = "EUC-JP";
  220.     } else {
  221.     $charset = &guess_charset($lang);
  222.     }
  223. }
  224.  
  225. sub lang_header {
  226.     if ($lang =~ /^ja/i) {
  227.     return &lang_header_ja(@_);
  228.     } else {
  229.     return &lang_header_default(@_);
  230.     }
  231. }
  232.  
  233. sub lang_body {
  234.     if ($lang =~ /^ja/i) {
  235.     return &lang_body_ja(@_);
  236.     } else {
  237.     return &lang_body_default(@_);
  238.     }
  239. }
  240.  
  241. sub lang_html_quote {
  242.     local($_) = @_;
  243.     if ($lang =~ /^ja/i) {
  244.     if (/[\x80-\xFF]/ || /\033[\$\(][BJ@]/) {
  245.         $_ = &conv_nkf("-e", $_);
  246.     }
  247.     }
  248.     return &html_quote($_);
  249. }
  250.  
  251. sub lang_header_default {
  252.     local($h) = @_;
  253.     if ($h =~ s/([=_?\x80-\xFF])/sprintf("=%02x", ord($1))/ge) {
  254.     return "=?$charset?Q?$h?=";
  255.     } else {
  256.     return $h;
  257.     }
  258. }
  259.  
  260. sub lang_body_default { 
  261.     local($body, $_7bit) = @_;
  262.     if ($body =~ /[\x80-\xFF]/) {
  263.     if ($_7bit) {
  264.         $body =~ s/([=\x80-\xFF])/sprintf("=%02x", ord($1))/ge;
  265.         return ($charset, "quoted-printable", $body);
  266.     } else {
  267.         return ($charset, "8bit", $body);
  268.     }
  269.     } else {
  270.     return ("US-ASCII", "7bit", $body);
  271.     }
  272. }
  273.  
  274. sub lang_header_ja {
  275.     local($h) = @_;
  276.     if ($h =~ /[\x80-\xFF]/ || $h =~ /\033[\$\(][BJ@]/) {
  277.     $h = &conv_nkf("-j", $h);
  278.     &conv_nkf("-M", $h);
  279.     } else {
  280.     return $h;
  281.     }
  282. }
  283.  
  284. sub lang_body_ja {
  285.     local($body, $_7bit) = @_;
  286.     if ($body =~ /[\x80-\xFF]/ || $body =~ /\033[\$\(][BJ@]/) {
  287.     if ($_7bit) {
  288.         $body = &conv_nkf("-j", $body);
  289.     }
  290.     return ("ISO-2022-JP", "7bit", $body);
  291.     } else {
  292.     return ("US-ASCII", "7bit", $body);
  293.     }
  294. }
  295.  
  296. sub conv_nkf {
  297.     local(@opt) = @_;
  298.     if ($use_NKF) {
  299.     return nkf(@opt);
  300.     }
  301.     local($body) = pop(@opt);
  302.     $body =~ s/\r+\n/\n/g;
  303.     $| = 1;
  304.     pipe(R, W2);
  305.     pipe(R2, W);
  306.     if (! fork()) {
  307.     close(F);
  308.     close(R);
  309.     close(W);
  310.     open(STDIN, "<&R2");
  311.     open(STDOUT, ">&W2");
  312.     exec "nkf", @opt;
  313.     die;
  314.     }
  315.     close(R2);
  316.     close(W2);
  317.     print W $body;
  318.     close(W);
  319.     $body = '';
  320.     while(<R>) {
  321.     $body .= $_;
  322.     }
  323.     close(R);
  324.     return $body;
  325. };
  326.  
  327.  
  328.  
  329. sub parse_opt {
  330.   local($opt) = @_;
  331.   local(%opt) = ();
  332.   if ($opt) {    
  333.       foreach $o (split('&', $opt)) {
  334.       if ($o =~ /(\w+)=(.*)/) {
  335.           $opt{"\L$1"} = &url_unquote($2);
  336.       }
  337.       }
  338.   }
  339.   return %opt;
  340. }
  341.  
  342. sub html_quote {
  343.   local($_) = @_;
  344.   local(%QUOTE) = (
  345.     '<', '<',
  346.     '>', '>',
  347.     '&', '&',
  348.     '"', '"',
  349.   );
  350.   s/[<>&"]/$QUOTE{$&}/g;
  351.   return $_;
  352. }
  353.  
  354. sub url_unquote {
  355.     local($_) = @_;
  356.     s/\+|%([0-9A-Fa-f][0-9A-Fa-f])/$& eq '+' ? ' ' : pack('c', hex($1))/ge;
  357.     return $_;
  358. }
  359.  
  360. sub guess_charset {
  361.     local(%lang_charset) = (
  362.     'cs', 'iso-8859-2',
  363.     'el', 'iso-8859-7',
  364.     'iw', 'iso-8859-8',
  365.     'ja', 'EUC-JP',
  366.     'ko', 'EUC-KR',
  367.     'hu', 'iso-8859-2',
  368.     'pl', 'iso-8859-2',
  369.     'ro', 'iso-8859-2',
  370.     'ru', 'iso-8859-5',
  371.     'sk', 'iso-8859-2',
  372.     'sl', 'iso-8859-2',
  373.     'tr', 'iso-8859-9',
  374.     'zh', 'GB2312',
  375.     );
  376.     local($_) = @_;
  377.     local($lang);
  378.  
  379.     if (! s/\.(.*)$//) {
  380.         if (/^zh_tw/i) {
  381.         return 'Big5';
  382.     }
  383.     /^(..)/;
  384.     return $lang_charset{$1} || 'iso-8859-1';
  385.     }
  386.     $lang = $_;
  387.     $_ = $1;
  388.     if (/^euc/i) {
  389.     if (/^euc$/i) {
  390.         $lang =~ /^zh_tw/ && return 'EUC-TW';
  391.         $lang =~ /^zh/ && return 'GB2312';
  392.         $lang =~ /^ko/ && return 'EUC-KR';
  393.         return 'EUC-JP';
  394.     }
  395.     /^euccn/i && return 'GB2312';
  396.     s/[\-_]//g;
  397.     s/^euc/EUC-/i;
  398.     tr/a-z/A-Z/;
  399.     } elsif (/^iso8859/i) {
  400.     s/[\-_]//g;
  401.     s/^iso8859/iso-8859-/i;
  402.     }
  403.     return $_;
  404. }
  405.